home *** CD-ROM | disk | FTP | other *** search
- The phone book example was wrote in vb4 16bit
-
- This code sets up a data file (redrum.dat) and shows how to create , remove
- search ,etc..... for your records
-
- dIsClaImEr--- I am not resposible for anything blahblahblah
-
-
- 'create a module and name it
- 'The Module
- Option Explicit
-
- Type info
-
- name As String * 20
- number As String * 10
-
- End Type
-
-
-
-
-
-
-
- 'THE form
-
- Option Explicit
-
- 'declares the main variables
-
- Dim A As info
- Dim filenum As Integer
- Dim recordlen As Long
- Dim currentrecord As Long
- Dim lastrecord As Long
-
-
-
- Public Sub SaveCurrentRecord()
- 'fills a with the current info
- A.name = txtname
- A.number = txtnumber
-
- 'saves to the currentrecord
-
- Put #filenum, currentrecord, A
-
-
-
- End Sub
-
- Public Sub ShowCurrentrecord()
-
- Get #filenum, currentrecord, A
-
- 'display the data
-
- txtname = Trim(A.name)
- txtnumber = Trim(A.number)
-
- End Sub
-
-
-
- Private Sub cmdDel_Click()
- 'delete the record /.... i copy the redrum.dat except for the current record then delete the txt and restore causing a deleted record
-
- Dim dirresult
- Dim tmpfilenum
- Dim tmpA As info
- Dim recnum As Long
- Dim tmprecnum As Long
- '
- 'confirm the deletion
- If MsgBox("Delete this name/number?", 4) <> 6 Then
- txtname.SetFocus
- Exit Sub
- End If
-
- If Dir("redrum.tmp") = "redrum.tmp" Then
- Kill "redrum.tmp"
- End If
- '
- '
- tmpfilenum = FreeFile
- Open "redrum.tmp" For Random As tmpfilenum Len = recordlen
- recnum = 1
- tmprecnum = 1
-
- Do While recnum < lastrecord + 1
- If recnum <> currentrecord Then
-
- Get #filenum, recnum, tmpA
- Put #tmpfilenum, tmprecnum, tmpA
- tmprecnum = tmprecnum + 1
- End If
-
- recnum = recnum + 1
- Loop
-
- 'delete the original file
- Close filenum
- Kill "redrum.dat"
-
- Close tmpfilenum
- 'rename the new file
- Name "redrum.tmp" As "redrum.dat"
- 'reopen it
- filenum = FreeFile
- Open "redrum.dat" For Random As filenum Len = recordlen
-
- lastrecord = lastrecord - 1
-
- If lastrecord = 0 Then
- lastrecord = 1
-
-
- If currentrecord > lastrecord Then
- currentrecord = lastrecord
- End If
- End If
-
- ShowCurrentrecord
-
- txtname.SetFocus
-
-
- End Sub
-
-
- Private Sub cmdExit_Click()
- End
-
- End Sub
-
-
- Private Sub cmdNew_Click()
- 'saves the current info
- SaveCurrentRecord
- 'add a blank record
- lastrecord = lastrecord + 1
- A.name = ""
- A.number = ""
-
- Put #filenum, lastrecord, A
-
- currentrecord = lastrecord
-
- ShowCurrentrecord
-
- txtname.SetFocus
-
-
-
-
-
- End Sub
-
- Private Sub cmdNext_Click()
-
- If currentrecord = lastrecord Then
- MsgBox "This is the last record in your list"
- Else
- SaveCurrentRecord
- currentrecord = currentrecord + 1
- ShowCurrentrecord
- End If
-
- End Sub
-
-
- Private Sub cmdPrev_Click()
-
- If currentrecord = 1 Then
- MsgBox "This is the first record in your list"
- Else
- SaveCurrentRecord
- currentrecord = currentrecord - 1
- ShowCurrentrecord
- End If
-
- End Sub
-
-
- Private Sub cmdSearch_Click()
-
- Dim nametosearch As String
- Dim found As Integer
- Dim recnum As Long
- Dim tmpA As info
-
- 'input box for the name to search for
-
- nametosearch = InputBox("Name to search for?", "sEarcH eNgInE")
-
- 'if the user enters null exit sub'
-
- If nametosearch = "" Then
- txtname.SetFocus
- Exit Sub
- End If
-
- 'use th UCASE function to convert the letters to UPPERCASE
- nametosearch = UCase(nametosearch)
- 'found flag = false
-
- found = False
-
- 'search for the name
- For recnum = 1 To lastrecord
- Get #filenum, recnum, tmpA
- If nametosearch = UCase(Trim(tmpA.name)) Then
- found = True
- Exit For
-
- End If
- Next
-
- 'display the name u searced for
-
- If found = True Then
- SaveCurrentRecord
- currentrecord = recnum
- ShowCurrentrecord
- Else
- MsgBox "" + nametosearch + "Not found"
- End If
-
- txtname.SetFocus
-
-
-
- End Sub
-
- Private Sub Form_Load()
-
- 'calculate the L.O.F
- recordlen = Len(A)
- 'get the next file number
- filenum = FreeFile
- 'open the file
- Open "redrum.dat" For Random As filenum Len = recordlen
- 'updaate the record
- currentrecord = 1
- 'find the last record
- lastrecord = FileLen("redrum.dat") / recordlen
-
- If lastrecord = 0 Then
- lastrecord = 1
- End If
-
- 'execute the ShowCurrentrecord procedure
-
- ShowCurrentrecord
-
-
-
- End Sub
-
-
- Private Sub Form_Unload(Cancel As Integer)
- Close filenum
-
- End Sub
-
-
-
-
-
-